unit uChoices;

interface
uses
  System.Generics.Collections, Vcl.CheckLst;

procedure CreateSalesforceFileAssociation();
procedure CreateSalesforceFileEditAssociation();
function CancelSalesforceFileAssociation():String;

type
  TChoice = class
    description: String;
    kind: String;
    options: String;
  end;
  TSingleChoice = class (TChoice)
    correctAnswer: Byte;
    constructor Create( desc: String; answer: Byte; king: String; opts: String = '' );
  end;
  TMultipleChoice = class (TChoice)
    correctAnswer: TList<Integer>;
    constructor Create( desc: String; answer: TList<Integer>; opts: String );
  end;
  TChoicesUtil = class
    class function LoadFromFile(const FileName: String): TList<TChoice>;
    class function LoadFileEdit(const FileName: String): TList<TChoice>;
    class procedure SaveFile(choices: TList<TChoice>; const FileName: String);
    class function AddMultiChoice(choices: TList<TChoice>; d: String; a: TList<Integer>; o: String): Integer;
    class function AddSingleChoice(choices: TList<TChoice>; d: String; a: Byte; k: String; o: String = ''): Integer;
    class procedure ConvertIntegerListToCheckBoxList(il: TList<Integer>; c: TCheckListBox);
    class procedure CopyCheckboxList(source, dest: TCheckListBox);
    class function TryImportFromFile(const FileName: String): TList<TChoice>;
  end;
implementation

uses SysUtils, Classes, Windows, Registry;

procedure CreateFileAssociation(Ext,ExtType,ExtDescript,FileIcon,FileOpen:string);
var
  reg:TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  reg.OpenKey(Ext,true);
  reg.WriteString('',ExtType);
  reg.CloseKey;
  reg.OpenKey(ExtType,true);
  reg.WriteString('',ExtDescript);
  reg.CloseKey;
  reg.OpenKey(ExtType+'\DefaultIcon',true);
  reg.WriteString('',FileIcon);
  reg.CloseKey;
  reg.OpenKey(ExtType+'\shell\open\command',true);
  reg.WriteString('',FileOpen);
  reg.CloseKey;
  reg.OpenKey(ExtType+'\shell\open in original order\command',true);
  reg.WriteString('',FileOpen + ' o');
  reg.CloseKey;
  reg.Free
end;

procedure CreateFileEditAssociation(Ext,ExtType,ExtDescript,FileEdit:string);
var
  reg:TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  reg.OpenKey(Ext,true);
  reg.WriteString('',ExtType);
  reg.CloseKey;
  reg.OpenKey(ExtType,true);
  reg.WriteString('',ExtDescript);
  reg.CloseKey;
  reg.OpenKey(ExtType+'\shell\edit\command',true);
  reg.WriteString('',FileEdit);
  reg.CloseKey;
  reg.Free
end;

function boolToBin(b: Boolean):Char;
begin
  if b then
    Result := '1'
  else
    Result := '0';
end;

function CancelFileAssociation(Ext,ExtType,PathToProgram:string):String;
var
  reg:TRegistry;
  extKeyExists,extTypeKeyExists,programValueExists,
  extKeyRemoved,extTypeKeyRemoved,programValueRemoved: Boolean;
begin
  reg := TRegistry.Create;
  try
  reg.RootKey := HKEY_CLASSES_ROOT;
  extKeyExists := reg.KeyExists(Ext);
  extTypeKeyExists := reg.KeyExists(ExtType);
  extKeyRemoved := reg.DeleteKey(Ext);
  extTypeKeyRemoved := reg.DeleteKey(ExtType);
  reg.RootKey := HKEY_CURRENT_USER;
  reg.OpenKey('Software\Microsoft\Windows\ShellNoRoam\MUICache',false);
  programValueExists := reg.ValueExists(PathToProgram);
  programValueRemoved := reg.DeleteValue(PathToProgram);
  Result := boolToBin(extKeyExists)+boolToBin(extTypeKeyExists)+boolToBin(programValueExists)
  + boolToBin(extKeyRemoved)+boolToBin(extTypeKeyRemoved)+boolToBin(programValueRemoved);
  finally
  reg.Free
  end
end;

const
  SFExt = '.sf';
  SFExtType = 'Salesforce Questionary';
  SFExtDesc = 'File containing questions and answers to prepare for Salesforce Certification';

procedure CreateSalesforceFileAssociation();
begin
  //CreateFileAssociation( SFExt, SFExtType, SFExtDesc, ParamStr(0)+',1',ParamStr(0)+' "%1"' );
  CreateFileAssociation( SFExt, SFExtType, SFExtDesc, ParamStr(0)+',0',ParamStr(0)+' "%1"' );
end;

procedure CreateSalesforceFileEditAssociation();
begin
  CreateFileEditAssociation( SFExt, SFExtType, SFExtDesc, ParamStr(0)+' "%1"' );
end;

function CancelSalesforceFileAssociation():String;
begin
  Result := CancelFileAssociation( SFExt, SFExtType, ParamStr(0) );
end;
{ TSingleChoice }

constructor TSingleChoice.Create(desc: String; answer: Byte; king: String; opts: String = '');
begin
  description := desc;
  correctAnswer := answer;
  kind := king;
  options := opts;
end;

{ TMultipleChoice }

constructor TMultipleChoice.Create(desc: String; answer: TList<Integer>; opts: String);
begin
  description := desc;
  correctAnswer := answer;
  if answer = Nil then
    correctAnswer := TList<Integer>.Create();
  kind := 'm';
  options := opts;
end;

{ TChoicesUtil }

class function TChoicesUtil.AddMultiChoice(choices: TList<TChoice>; d: String; a: TList<Integer>; o: String): Integer;
var
  c: TChoice;
begin
  c := TMultipleChoice.Create( d, a, o);
  Result := choices.Add(c);
end;

class function TChoicesUtil.AddSingleChoice(choices: TList<TChoice>; d: String; a: Byte; k: String; o: String = ''): Integer;
var
  c: TChoice;
begin
  c := TSingleChoice.Create( d, a, k, o);
  Result := choices.Add(c);
end;

class procedure TChoicesUtil.ConvertIntegerListToCheckBoxList(
  il: TList<Integer>; c: TCheckListBox);
var
  i: Integer;
begin
  for i := 0 to c.Items.Count - 1 do begin
    c.Checked[i] := False;
  end;
  for i := 0 to il.Count - 1 do begin
    c.Checked[il[i]] := True;
  end;
end;

class procedure TChoicesUtil.CopyCheckboxList(source, dest: TCheckListBox);
var
  i: Integer;
begin
  for i := 0 to Source.Items.Count - 1 do begin
    dest.Checked[i] := Source.Checked[i];
  end;
end;

class function TChoicesUtil.LoadFromFile(const FileName: String): TList<TChoice>;
var
  i, j, l, m, n: Integer;
  kind, d, desc, opts: String;
  il: TList<Integer>;
  f:TextFile;
  ext:string;
begin
  ext := '.sf';
  Result := TList<TChoice>.Create();
  if fileexists(FileName) then begin
    assignfile(f,FileName);
    ext := LowerCase(ExtractFileExt(FileName));
    reset(f);
    try


    readln(f, l);
    for i := 0 to l - 1 do begin
      readln(f, kind);
      readln(f, m);
      desc := '';
      for j := 0 to m - 1 do begin
        readln(f, d);
        desc := desc + d + #13#10;
      end;
      opts := '';
      if kind <> 'b' then begin
        readln(f, m);

        for j := 0 to m - 1 do begin
          readln(f, d);
          opts := opts + d + #13#10;
        end;
      end;
      if kind = 'm' then
        addMultiChoice(Result, desc, nil, opts)
      else
        addSingleChoice(Result, desc, 0, kind, opts);
    end;
    for i := 0 to l - 1 do begin
      if Result[i].kind = 'm' then begin
        il := TList<Integer>.Create();
        readln(f, m);
        for j := 0 to m - 1 do begin
          read(f, n);
          il.add(n);
        end;
        readln(f);
        TMultipleChoice(Result[i]).correctAnswer := il;
      end else begin
        readln(f, n);
        TSingleChoice(Result[i]).correctAnswer := n;
      end;
    end;
    finally
      closeFile(f);
    end;

  end;

end;

class function TChoicesUtil.LoadFileEdit(const FileName: String): TList<TChoice>;
var
  i, j, l, m, n: Integer;
  kind, d, desc, opts: String;
  il: TList<Integer>;
  f:TextFile;
  ext:string;
  success: Boolean;
  s: String;
begin
  ext := '.sf';
  Result := TList<TChoice>.Create();
  if fileexists(FileName) then begin
    assignfile(f,FileName);
    ext := LowerCase(ExtractFileExt(FileName));
    reset(f);
    try


    readln(f, l);
    for i := 0 to l - 1 do begin
      readln(f, kind);
      readln(f, m);
      desc := '';
      for j := 0 to m - 1 do begin
        readln(f, d);
        desc := desc + d + #13#10;
      end;
      opts := '';
      if kind <> 'b' then begin
        readln(f, m);

        for j := 0 to m - 1 do begin
          readln(f, d);
          opts := opts + d + #13#10;
        end;
      end;
      if kind = 'm' then
        addMultiChoice(Result, desc, nil, opts)
      else
        addSingleChoice(Result, desc, 0, kind, opts);
    end;
    for i := 0 to l - 1 do begin
      if Result[i].kind = 'm' then begin
        il := TList<Integer>.Create();

        success := False;
        m := 0;
        repeat
          readln(f, s);
        try
          m := StrToInt( s );

          success := True;
        except on E: Exception do
          if (Pos('is not a valid integer value', E.Message) > 0) and (s.Length > 0) then begin
            kind := s[1];
            readln(f, m);
            desc := '';
            for j := 0 to m - 1 do begin
              readln(f, d);
              desc := desc + d + #13#10;
            end;
            opts := '';
            if kind <> 'b' then begin
              readln(f, m);

              for j := 0 to m - 1 do begin
                readln(f, d);
                opts := opts + d + #13#10;
              end;
            end;
            if kind = 'm' then
              addMultiChoice(Result, desc, nil, opts)
            else
              addSingleChoice(Result, desc, 0, kind, opts);

            ///readln(f, m);
          end else
            success := True;
        end;

        until (success);

        for j := 0 to m - 1 do begin
          read(f, n);
          il.add(n);
        end;
        readln(f);
        TMultipleChoice(Result[i]).correctAnswer := il;
      end else begin
        readln(f, n);
        TSingleChoice(Result[i]).correctAnswer := n;
      end;
    end;
    finally
      closeFile(f);
    end;

  end;

end;

class procedure TChoicesUtil.SaveFile(choices: TList<TChoice>;
  const FileName: String);
var
  i,j:Integer;
  fn:string;
  sl: TStringList;
  il: TList<Integer>;
  f:TextFile;
  ext:string;
begin
  ext := '.sf';
  fn := ChangeFileExt(FileName, ext);
  AssignFile(f, fn);
  rewrite(f);
  try
    writeln(f, choices.Count);
    sl := TStringList.Create;
    //il := TList<Integer>.Create;
    for i := 0 to choices.Count - 1 do begin
      writeln(f, choices[i].kind);
      sl.Text := choices[i].description;
      writeln(f, sl.Count);
      write(f, sl.Text);
      if choices[i].kind <> 'b' then begin
        sl.Text := choices[i].options;
        writeln(f, sl.Count);
        write(f, sl.Text);
      end;

    end;
    for i := 0 to choices.Count - 1 do begin
      if choices[i].kind = 'm' then begin
        il := TMultipleChoice(choices[i]).correctAnswer;
        writeln(f, il.Count);
        if il.Count > 0 then begin
          for j := 0 to il.Count - 1 do
            write(f, il[j], ' ');
          writeln(f);
        end;
      end else begin
        writeln(f, TSingleChoice(choices[i]).correctAnswer);
      end;
    end;
  finally
    closeFile(f);
  end;
 //caption:=fn
end;

class function TChoicesUtil.TryImportFromFile(const FileName: String): TList<TChoice>;
var
  j: Integer;
  s, kind, d, desc, opts: String;
  il: TList<Integer>;
  alpha, bool, squareBracket: Boolean;
  aChar: Char;
  f:TextFile;
begin
  Result := TList<TChoice>.Create();
  if fileexists(FileName) then begin
    assignfile(f,FileName);
    reset(f);
    try // try
      if eof(f) then
        raise Exception.Create('Empty File!');
      readln(f, s);

      repeat
        desc := '';
        if (pos('[', s) > 0) or (pos('(', s) = 1) then
          if (pos('[', s) > 0) and (pos('(', s) > 0) then
            squareBracket := (pos('[', s) < pos('(', s))
          else
            squareBracket := (pos('[', s) > 0);
          if squareBracket then
            j := pos(']', s)
          else
            j := pos(')', s);

          if s[j + 1] = ' ' then
            desc := desc + Copy(s, j + 2, Length(s) - j)
          else
            desc := desc + Copy(s, j + 1, Length(s) - j);// + #13#10;

        repeat
          if eof(f) then
            raise Exception.Create('Incomplete of broken File!');
          readln(f, s);
          d := Copy(s, 1, 3);
          if (d <> 'Ans') and (s[1] <> 'A') and (Copy(s, 1, 2) <> '1.') then
            desc := desc + ' ' + s;// + #13#10;
        until (s[1] = 'A') or ( Copy(s, 1, 2) = '1.') or ( d = 'Ans') or eof(f);
        bool := d = 'Ans';
        alpha := s[1] = 'A';
        if alpha then
          aChar := 'A'
        else
          aChar := '1';
        opts := '';
        opts := opts + s;// + #13#10;
        if not bool then

        repeat
          if eof(f) then
            raise Exception.Create('Incomplete of broken File!');
          readln(f, s);
          d := Copy(s, 1, 3);
          if d <> 'Ans' then
            if (Ord(d[1]) - Ord(aChar) >= 0) and (Ord(d[1]) - Ord(aChar) < 10) and (Copy(d, 2, 2) = '. ') then
              opts := opts + #13#10 + s
            else
              opts := opts + ' ' + s;// + #13#10;
        until (d = 'Ans') or eof(f);
        if (Pos('Ans: ', s) > 0) or (Pos('Ans; ', s) > 0) then
          d := Copy(s, 6, Length(s) - 5)
        else
          d := Copy(s, 5, Length(s) - 4);
        if bool then
          kind := 'b'
        else
        if Length(d) = 1 then
          kind := 's'
        else
          kind := 'm';
        if kind = 'm' then begin
          il := TList<Integer>.Create();
          for j := 1 to Length(d) do begin
            il.add( Ord(d[j]) - Ord(aChar));
          end;
          addMultiChoice(Result, desc, il, opts)
        end else if kind = 's' then begin
          addSingleChoice(Result, desc, Ord(d[1]) - Ord(aChar), kind, opts);
        end else begin
          if LowerCase(d) = 'true' then
            j := 0
          else
            j := 1;
          addSingleChoice(Result, desc, j, kind, opts);
        end;
        if not eof(f) then
          repeat
            if eof(f) then
              raise Exception.Create('Incomplete of broken File!');
            readln(f, s);
          until (Trim(s) <> '') or eof(f);

      until eof(f);
    (*except on e:Exception do
    ;
    end;*)
    finally
      closeFile(f);
    end;

  end;
// Application.Title:=fn;
// caption:=fn;

end;


end.
